home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / sthing.com / TPTALK.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-10-28  |  4.6 KB  |  203 lines
  1. {
  2.   TPTALK is a simple program that demonstrates the STHING unit.
  3.   If you specify the name of an ASCII text file on the command line when you
  4.   call TPTALK, it will read the file for you. If don't specify a file name,
  5.   you can enter text and TPTALK will speak each line as you enter it.
  6.  
  7.   In general, TPTALK does the same thing as the TALK program supplied with the
  8.   Speech Thing. It accepts the following command line options:
  9.  
  10.      /?         show a list of options
  11.      /T n       specify tone (0 or 1)
  12.      /I n       specify pitch (0..9)
  13.      /S n       specify speed (0..9)
  14.      /V n       specify volume (0..9)
  15.      /L n       specify LPT port (1..3)
  16.  
  17.   Unlike TALK, TPTALK won't load the SPEECHVx program if it isn't already
  18.   loaded. Note that TPTALK needs only SPEECHV2 or SPEECHV3; it is *not*
  19.   necessary to load STALK.
  20.  
  21.   Written 10/90 by Kim Kokkonen, TurboPower Software
  22.   Copyright (C) 1990, TurboPower Software. All rights reserved.
  23. }
  24.  
  25. {$S-,I-,R-,V-,F-}
  26. {$M 8192,0,655360}
  27.  
  28. program TpTalk;
  29.  
  30. uses
  31.   sthing;
  32.  
  33. const
  34.   modulename : string[6] = 'TPTALK';
  35.   version = '1.00';
  36.  
  37.   {default values for speech parameters}
  38.   tone : word = 5;
  39.   volume : word = 5;
  40.   pitch : word = 5;
  41.   speed : word = 5;
  42.   lpt : word = 1;
  43.  
  44. var
  45.   {file to speak}
  46.   filename : string[79];
  47.  
  48. procedure analyzecommandline;
  49. var
  50.   i : word;
  51.   arg : string[127];
  52.  
  53.   procedure writehelp;
  54.   begin
  55.     writeln('Usage:');
  56.     writeln('  TPTALK [options] [filename]');
  57.     writeln('Command line options:');
  58.     writeln('  /I n       specify pitch (0..9)');
  59.     writeln('  /L n       specify LPT port (1..3)');
  60.     writeln('  /S n       specify speed (0..9)');
  61.     writeln('  /T n       specify tone (0 or 1)');
  62.     writeln('  /V n       specify volume (0..9)');
  63.     halt;
  64.   end;
  65.  
  66.   procedure invalidoption;
  67.   begin
  68.     writeln('Invalid command line option: ', arg);
  69.     writehelp;
  70.   end;
  71.  
  72.   function stupcase(s : string) : string;
  73.   var
  74.     p : word;
  75.   begin
  76.     stupcase[0] := s[0];
  77.     for p := 1 to length(s) do
  78.       stupcase[p] := upcase(s[p]);
  79.   end;
  80.  
  81.   function getnum(min, max : word) : word;
  82.     {-validate and return number in range min..max}
  83.   var
  84.     num : word;
  85.     code : word;
  86.   begin
  87.     if i = paramcount then
  88.       invalidoption
  89.     else begin
  90.       inc(i);
  91.       arg := stupcase(paramstr(i));
  92.       val(arg, num, code);
  93.       if (code <> 0) or (num < min) or (num > max) then
  94.         invalidoption
  95.       else
  96.         getnum := num;
  97.     end;
  98.   end;
  99.  
  100. begin
  101.   {no file to speak by default}
  102.   filename := '';
  103.  
  104.   i := 1;
  105.   while i <= paramcount do begin
  106.     arg := stupcase(paramstr(i));
  107.     case arg[1] of
  108.       '/', '-' :
  109.         if length(arg) <> 2 then
  110.           invalidoption
  111.         else
  112.           case arg[2] of
  113.             '?' : writehelp;
  114.             'I' : pitch := getnum(0, 9);
  115.             'L' : lpt := getnum(1, 3);
  116.             'S' : speed := getnum(0, 9);
  117.             'T' : tone := getnum(0, 1);
  118.             'V' : volume := getnum(0, 9);
  119.           else
  120.             invalidoption;
  121.           end;
  122.     else
  123.       if filename = '' then
  124.         filename := arg
  125.       else
  126.         invalidoption;
  127.     end;
  128.     inc(i);
  129.   end;
  130.  
  131.   {set the speech options}
  132.   stsetlptport(lpt);
  133.   stsetparams(tone, volume, pitch, speed);
  134. end;
  135.  
  136. procedure speakfromkeyboard;
  137. var
  138.   s : string;
  139.   ps : string;
  140. begin
  141.   writeln('Enter text to speak. Empty line to quit...');
  142.   repeat
  143.     readln(s);
  144.     if s <> '' then begin
  145.       {convert to phonetic}
  146.       StTextToPhonetic(s, ps);
  147.       writeln(ps);
  148.       stspeak(s);
  149.     end;
  150.   until s = '';
  151. end;
  152.  
  153. procedure speakfile(filename : string);
  154. label
  155.   exitpoint;
  156. var
  157.   s : string;
  158.   f : text;
  159.  
  160.   function keypressed : boolean;
  161.     {-return True if a key has been pressed}
  162.   Inline(
  163.   $B4/$01/               {mov ah,1}
  164.   $CD/$16/               {int $16}
  165.   $B0/$00/               {mov al,0}
  166.   $74/$02/               {jz nokey}
  167.   $FE/$C0);              {inc al}
  168.                          {nokey:}
  169.  
  170. begin
  171.   assign(f, filename);
  172.   reset(f);
  173.   if ioresult <> 0 then begin
  174.     writeln('Unable to open ', filename);
  175.     halt;
  176.   end;
  177.   while not eof(f) do begin
  178.     readln(f, s);
  179.     if ioresult <> 0 then
  180.       goto exitpoint;
  181.     writeln(s);
  182.     stspeak(s);
  183.     if keypressed then
  184.       goto exitpoint;
  185.   end;
  186. exitpoint:
  187.   close(f);
  188.   if ioresult <> 0 then ;
  189. end;
  190.  
  191. begin
  192.   if not stloaded then begin
  193.     writeln('SPEECHVx must be loaded first');
  194.     halt;
  195.   end;
  196.   writeln(modulename, ', Version ', version, ', by TurboPower Software');
  197.   analyzecommandline;
  198.   if filename = '' then
  199.     speakfromkeyboard
  200.   else
  201.     speakfile(filename);
  202. end.
  203.